home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / games / 144 / pascal / pplistac.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-06-16  |  25.6 KB  |  548 lines

  1. {$A+,D-,S10} {Compiler directives to make a desk accessory)
  2. { A+ only works with versions of Personal Pascal newer than 1.02
  3.   D- turns off debug code
  4.   S10 limits stack/heap space for this accessory to 10 kbytes}
  5.  
  6. {******************************************************************************
  7.  
  8. Some conventions used in this listing:
  9.  
  10.    Words in all capital letters (e.g. CHR) are Personal Pascal reserved words.
  11.  
  12.    Words with mixed capital and lower case letters (e.g. Text) are Personal
  13.      Pascal constants, types, functions, or procedures as shown in the manual
  14.      or in the included library (GEMCONST.PAS, GEMTYPE.PAS, GEMSUBS.PAS).
  15.      There seems to be no significance to whether these words are one word
  16.      (e.g. Text) or multiple words separated by an underline (e.g. Path_Name).
  17.  
  18.    Words in all lower case letters are mine:
  19.      Variables are one word (e.g. path).
  20.      Functions and procedures are two or more words separated with an underline
  21.        (e.g. do_title).
  22.  
  23. ******************************************************************************}
  24.  
  25. PROGRAM personal_pascal_sourcecode_lister_accessory;
  26.   {PPLISTER by Dave Rajala, 1987}
  27.   {Portions are Copyright (c)1986 CCD and OSS. Used by permission of OSS.}
  28.  
  29.   {PPLISTER prints Personal Pascal source code files with line numbers added for
  30.    reference.  Epson compatable, elite-font-capable printer required.  PPLISTER
  31.    demonstrates GEM dialog boxes, alert boxes, windows, and messages as a desk
  32.    accessory.}
  33.  
  34.  
  35. CONST
  36.   {$I GEMCONST.PAS}
  37.   AC_Open = 40;
  38.   AC_Close = 41;
  39.  
  40.  
  41. TYPE
  42.   {$I GEMTYPE.PAS}
  43.  
  44.  
  45. VAR {Global Variables}
  46.   path       : Path_Name;       {String[80] to store path for file selector}
  47.   userfile   : Path_Name;       {String[80] to store file name selected}
  48.   disk       : FILE OF Text;    {File buffer required for disk I/O}
  49.   printer    : FILE OF Text;    {File buffer required for printer output}
  50.   x,y,w,h    : Integer;         {Upperleft screen coordinate and desktop size}
  51.   cw,ch      : Integer;         {Character width and height}
  52.   wx,wy,ww,wh : Integer;        {Upperleft coordinate/size of progress window}
  53.   ox,oy,ow,oh : Integer;        {Old coordinate/size of progress window}
  54.   wwc,whc    : Integer;         {Window width and height in character units}
  55.   px,py      : Integer;         {Upperleft coordinate of progress message}
  56.   pagestr    : String;          {Progress message for page number}
  57.   linestr    : String;          {Progress message for line number}
  58.   intstr     : String;          {String containing an integer for displaying}
  59.   progwind   : Integer;         {Handle of progress window}
  60.   wtitle     : Window_Title;    {String[80] for progress window title}
  61.   winfo      : String;          {Progress window info line}
  62.   msg        : Message_Buffer;  {Array[0..15] of Integer for event messages}
  63.   key        : Integer;         {Value of last key pressed for event messages}
  64.   linenum    : Integer;         {Line number for source code listing}
  65.   pagenum    : Integer;         {Page number for source code listing}
  66.   junk       : Integer;         {Collects useless data}
  67.   junkb      : Boolean;         {Ditto}
  68.   ap_id      : integer;         {ID of this desk accessory}
  69.   ourname    : String;          {Name of our accessory for DESK menu}
  70.   picked     : Boolean;         {Whether file selected}
  71.   runbefore  : Boolean;         {Whether accessory has been called before}
  72.  
  73. {$I GEMSUBS.PAS}
  74.  
  75.  
  76. FUNCTION do_title : Boolean; {Creates and displays title screen dialog box}
  77.   {Returns true/false whether user clicks 'Print File'}
  78.   VAR {Local}
  79.     titlebox   : Dialog_Ptr;      {^Char variable for handle of dialog box}
  80.     tline1     : Integer;         {Handle of text line 1 for dialog box}
  81.     tline2     : Integer;         {Ditto for line 2}
  82.     tline3     : Integer;         {Ditto for line 3}
  83.     tline4     : Integer;         {Ditto for line 4}
  84.     tline5     : Integer;         {Ditto for line 5}
  85.     tline6     : Integer;         {Ditto for line 6}
  86.     tline7     : Integer;         {Ditto for line 7}
  87.     quit       : Integer;         {Handle of QUIT button in dialog box}
  88.     printfile  : Integer;         {Handle of PRINT FILE button in dialog box}
  89.     pushed     : Tree_Index;      {Item which causes return from dialog box}
  90.     textstring : String[40];      {Used to print non-keyboard characters}
  91.   BEGIN
  92.     titlebox := New_Dialog {New dialog box with handle 'titlebox'}
  93.       (10,                 {Can contain a max of 10 items}
  94.       0,0,                 {Disregard upperleft coordinate of box}
  95.       40,12);              {Box size is 40 characters by 12 lines}
  96.     tline1 := Add_DItem  {Add item to dialog box with handle 'tline1'}
  97.               (titlebox, {Handle of box}
  98.               G_Text,    {Item is a non-editable text line}
  99.               None,      {No special flags}
  100.               1,         {Start in first character position}
  101.               1,         {of first line in box}
  102.               38,1,      {This item 38 characters wide and 1 line high}
  103.               0,         {No border around this item}
  104.               (Black*256){Text color Black}
  105.               |128);     {Drawn in replace mode}
  106.     {Add rest of lines}
  107.     tline2 := Add_DItem (titlebox,G_Text,None,1,2,38,1,0,(Black*256)|128);
  108.     tline3 := Add_DItem (titlebox,G_Text,None,1,3,38,1,0,(Black*256)|128);
  109.     tline4 := Add_DItem (titlebox,G_Text,None,1,4,38,1,0,(Black*256)|128);
  110.     tline5 := Add_DItem (titlebox,G_Text,None,1,5,38,1,0,(Black*256)|128);
  111.     tline6 := Add_DItem (titlebox,G_Text,None,1,6,38,1,0,(Black*256)|128);
  112.     tline7 := Add_DItem (titlebox,G_Text,None,1,7,38,1,0,(Black*256)|128);
  113.     printfile := Add_DItem {Add item to dialog box with handle 'printfile'}
  114.             (titlebox,   {Handle of box}
  115.             G_Button,    {This item is a button}
  116.             Selectable|  {The button can be clicked}
  117.             Touch_Exit|  {Exit the dialog box when button clicked}
  118.             Default,     {Exit the dialog box when RETURN key pressed}
  119.             6,           {Upperleft corner of button on 6th character}
  120.             9,           {of 9th line of dialog box}
  121.             14,2,        {Button 14 characters wide and 2 lines high}
  122.             junk,        {Border meaningless for button}
  123.             junk);       {Color meaningless for button}
  124.     quit := Add_DItem {Add item to dialog box with handle 'quit'}
  125.             (titlebox,   {Handle of box}
  126.             G_Button,    {This item is a button}
  127.             Selectable|  {The button can be clicked}
  128.             Touch_Exit,  {Exit the dialog box when button clicked}
  129.             26,          {Upperleft corner of button on 26th character}
  130.             9,           {of 9th line of dialog box}
  131.             8,2,         {Button 8 characters wide and 2 lines high}
  132.             junk,        {Border meaningless for button}
  133.             junk);       {Color meaningless for button}
  134.     {Assign text to the dialog box items}
  135.     Set_DText(titlebox,                     {Dialog box handle}
  136.       tline1,                               {Item handle}
  137.       'Personal Pascal Source Code Lister', {Text}
  138.       System_Font,                          {Use system font}
  139.       TE_Center);                           {Center text}
  140.     Set_DText(titlebox,tline2,'Author:  Dave Rajala',System_Font,TE_Center);
  141.     Set_DText(titlebox,tline3,'Rev 1.00',System_Font,TE_Center);
  142.     Set_DText(titlebox,tline4,'This Program Placed in Public Domain.',
  143.       System_Font,TE_Center);
  144.     Set_DText(titlebox,tline5,' ',System_Font,TE_Center);
  145.     textstring := CONCAT('Portions Copyright ',CHR(189),'1986 OSS/CCD.');
  146.     Set_DText(titlebox,tline6,textstring,System_Font,TE_Center);
  147.     Set_DText(titlebox,tline7,'Used by permission of OSS.',System_Font,
  148.       TE_Center);
  149.     Set_DText(titlebox,printfile,' PRINT FILE ',System_Font,TE_Center);
  150.     Set_DText(titlebox,quit,' QUIT ',System_Font,TE_Center);
  151.     Center_Dialog(titlebox);                  {Center dialog box on screen}
  152.     pushed := Do_Dialog(titlebox,0);          {Display box and wait for return}
  153.       {Contrary to manual, 2d parameter of Do_Dialog is meaningful even if}
  154.       {no editable text items in box.  Must be 0 if no editable text items}
  155.     End_Dialog(titlebox);                     {Remove box from screen}
  156.     Delete_Dialog(titlebox);                  {Release memory back to GEM}
  157.     do_title := (pushed = printfile);         {TRUE if 'print file' clicked}
  158.   END; {do_title}
  159.  
  160.  
  161. FUNCTION current_drive : Integer; {Returns current drive, 0=A, 1=B, etc}
  162.   GEMDOS ($19);
  163.  
  164.  
  165. FUNCTION printer_stat : Integer; {Returns -1 if printer ready, 0 if not}
  166.   GEMDOS ($11);
  167.  
  168.  
  169. FUNCTION printer_ok : Boolean; {Returns true/false whether printer ok}
  170.   VAR {Local}
  171.     status    : Integer;      {Printer status}
  172.     errordata : String[255];  {Data for printer-not-ready alert box}
  173.   BEGIN {printer_ok}
  174.     status := printer_stat;                   {Get printer status}
  175.     IF status = 0 THEN                        {If printer not ok}
  176.       BEGIN                                   {Do alert box}
  177.         errordata := CONCAT ('[0]',             {No sign}
  178.           '[            ',CHR(28),CHR(29),' |', {Bob}
  179.            '            ',CHR(30),CHR(31),' |', {Bob}
  180.            '         Bob says          |',      {Text lines, 30 character max}
  181.            'THE PRINTER''S NOT READY!  ]',
  182.            '[Understood]');                     {Button name}
  183.         junk := Do_Alert (errordata,1);       {Display box and wait for button}
  184.       END; {If status=0}
  185.     printer_ok := (status <> 0);
  186.   END; {printer_ok}
  187.  
  188.  
  189. FUNCTION open_file (userfile : Path_Name): Boolean;
  190.   {Tries to open file selected and returns true/false whether successful}
  191.   VAR {Local}
  192.     status    : Integer;      {I/O status of file}
  193.     errordata : String[255];  {Stores data for I/O error alert box}
  194.     badfile   : String[30];   {Stores filename (possibly truncated)}
  195.   BEGIN
  196.     IO_CHECK (FALSE);         {Turn off system error checking}
  197.     RESET (disk, userfile);   {Open selected file for input}
  198.     status := IO_RESULT;      {Get status}
  199.     IO_CHECK (TRUE);          {Turn system error checking back on}
  200.     IF status <> 0            {If error opening disk file}
  201.       THEN BEGIN
  202.         IF LENGTH(userfile) > 30                {Limit file name to 30 char}
  203.           THEN badfile := COPY(userfile,1,30)   {or GEM will bomb}
  204.           ELSE badfile := COPY(userfile,1,LENGTH(userfile));
  205.         errordata := CONCAT ('[0]',              {No sign}
  206.           '[             ',CHR(28),CHR(29),' |', {Bob}
  207.            '             ',CHR(30),CHR(31),' |', {Bob}
  208.            '          Bob says         |',      {Text lines, 30 characters max}
  209.            'ERROR TRYING TO OPEN FILE: |',
  210.             badfile,']',
  211.            '[ OK ]');                           {Button name}
  212.         junk := Do_Alert (errordata,1);       {Display box and wait for button}
  213.       END; {If}
  214.     open_file := (status = 0);
  215.   END; {open_file}
  216.  
  217.  
  218. PROCEDURE int_to_str (number : Long_Integer; VAR intstr : String);
  219.   {Receives integer and string, puts integer value into string.  Assumes
  220.    integer always positive.}
  221.   BEGIN
  222.     intstr := ' ';                      {Init string with 1 character}
  223.                                         {so INSERT won't bomb on null string}
  224.     WHILE number > 0 DO                 {While there's a significant digit}
  225.       BEGIN
  226.         INSERT(CHR((number MOD 10)+48), {Convert lowest digit to ascii char}
  227.           intstr,1);                    {Insert it at beginning of string}
  228.         number := number DIV 10;        {Reduce number by 1 digit}
  229.       END; {While}
  230.     IF intstr = ' '                     {If intstr is ' ', number was zero}
  231.       THEN intstr := '0'                {So show as '0' or}
  232.       ELSE intstr := COPY(intstr,1,LENGTH(intstr)-1);    {Strip trailing blank}
  233.   END; {int_to_str}
  234.  
  235.  
  236. PROCEDURE create_progwind; {Creates GEM window to show printing progress}
  237.   BEGIN
  238.     wtitle := '  PRINTING  ';
  239.     progwind := New_Window    {New window with handle 'progwind'}
  240.       (G_Name                 {It will have a name}
  241.       |G_Info                 {and an info line}
  242.       |G_Move                 {It can be moved}
  243.       |G_Close                {and closed}
  244.       |G_UpArrow              {It'll have arrows just for looks}
  245.       |G_DnArrow
  246.       |G_LArrow
  247.       |G_RArrow,
  248.       wtitle,                 {Window title must be in a string variable}
  249.       0,0,0,0);               {Window can be drawn as large as the desktop}
  250.   END; {create_progwind}
  251.  
  252.  
  253. PROCEDURE display_progwind; {Display progress window on screen}
  254.   VAR {Local}
  255.     i     : Integer;                    {FOR counter}
  256.   BEGIN
  257.     px := wx + cw*((wwc DIV 2) - 7);    {Coordinates for progress prompt}
  258.     py := wy + ch*(whc DIV 2);          {See initialize for variable values}
  259.     {Center userfile in winfo string}
  260.     IF LENGTH(userfile) > wwc -1        {If file name wider than window}
  261.       THEN
  262.         winfo := COPY(userfile,1,wwc)   {Truncate file name to window width}
  263.       ELSE                              {If file name smaller than window}
  264.         BEGIN
  265.           winfo := COPY(userfile,1,LENGTH(userfile));   {Copy file name}
  266.           FOR i := 1 to ((wwc DIV 2)-(LENGTH(userfile) DIV 2)) DO
  267.             INSERT(' ',winfo,1);      {Insert blanks to center file name}
  268.         END; {Else}
  269.     Set_WInfo(progwind,winfo);        {Put file name in window info line}
  270.     Hide_Mouse;                       {Prevent mouse cursor interferring}
  271.     Paint_Color (White);
  272.    Paint_Rect (wx,wy,ww,wh);          {Paint window area before drawing window}
  273.     Open_Window(progwind,wx,wy,ww,wh);{Draw window}
  274.     Draw_String (px,py,pagestr);      {Draw pagenum prompt in window}
  275.     int_to_str(pagenum,intstr);       {Convert page number to string}
  276.     Draw_String (px+cw*LENGTH(pagestr),py,intstr);  {Draw it in window}
  277.     Draw_String (px,py+ch*2,linestr); {Draw linenum prompt in window}
  278.     int_to_str(linenum,intstr);       {Convert line number to string}
  279.     Draw_String (px+cw*LENGTH(linestr),py+ch*2,intstr); {Draw it in window}
  280.     Show_Mouse;
  281.   END; {display_progwind}
  282.  
  283.  
  284. PROCEDURE update_linenum;  {Displays linenum currently printing}
  285.   BEGIN
  286.     IF Front_Window = progwind THEN        {If progress window is front window}
  287.       BEGIN
  288.         int_to_str(linenum,intstr);        {Convert line number to string}
  289.         Draw_String (px+cw*LENGTH(linestr),py+ch*2,intstr); {Draw it in window}
  290.       END; {If}
  291.   END; {update_linenum}
  292.  
  293.  
  294. PROCEDURE update_pagenum;  {Displays pagenum currently printing}
  295.   BEGIN
  296.     IF Front_Window = progwind THEN        {If progress window is front window}
  297.       BEGIN
  298.         int_to_str(pagenum,intstr);        {Convert page number to string}
  299.         Draw_String (px+cw*LENGTH(pagestr),py,intstr);  {Draw it in window}
  300.       END; {If}
  301.   END; {update_pagenum}
  302.  
  303.  
  304. PROCEDURE do_redraw; {Redraws progress window based on GEM messages}
  305.   VAR {Local}
  306.     rx,ry,rw,rh : Integer;     {Size of redraw rectangle}
  307.   BEGIN
  308.     Paint_Color(White);
  309.     Begin_Update;              {Prevent further screen changes while redrawing}
  310.     Hide_Mouse;
  311.     First_Rect(msg[3],rx,ry,rw,rh);       {First redraw rectangle from GEM}
  312.     WHILE (rw <> 0) AND (rh <> 0) DO      {While there's a rectangle to redraw}
  313.       BEGIN
  314.         IF Rect_Intersect(msg[4],msg[5],msg[6],msg[7],rx,ry,rw,rh) THEN
  315.           BEGIN                {If redraw area intersects with progress window}
  316.             Set_Clip(rx,ry,rw,rh);        {Draw only in intersection rectangle}
  317.             Paint_Rect (rx,ry,rw,rh);     {Paint it white}
  318.             Draw_String (px,py,pagestr);  {Draw pagenum prompt}
  319.             int_to_str(pagenum,intstr);   {Convert page number to string}
  320.             Draw_String (px+cw*LENGTH(pagestr),py,intstr);  {Draw it}
  321.             Draw_String (px,py+ch*2,linestr);  {Draw linenum prompt}
  322.             int_to_str(linenum,intstr);   {Convert line number to string}
  323.             Draw_String (px+cw*LENGTH(linestr),py+ch*2,intstr);  {Draw it}
  324.           END; {If}
  325.         Next_Rect(msg[3],rx,ry,rw,rh);    {Get any more redraw rectangles}
  326.       END; {While}
  327.     Show_Mouse;
  328.     End_Update; {Allow other screen changes}
  329.   END; {do_redraw}
  330.  
  331.  
  332. PROCEDURE do_move;            {Moves progress window}
  333.   BEGIN
  334.     wx := msg[4];             {Accept new upperleft coordinates}
  335.     wy := msg[5];
  336.     Close_Window(progwind);   {Erase current window}
  337.     display_progwind;         {Draw the new window}
  338.   END; {do_move}
  339.  
  340.  
  341. PROCEDURE get_messages; {Returns any pending GEM messages in 'msg' and key}
  342.   BEGIN
  343.                         {Since this returns immediately (timer=0)}
  344.     msg[0] := 0;        {Clear msg buffer to avoid repeating last message}
  345.     junk := Get_Event (E_Message|E_Timer  {Check messages,timer}
  346.                        |E_Keyboard,       {and keys}
  347.                        0,0,0,             {Disregard mouse buttons}
  348.                        0,                 {Return immediately (when timer=0)}
  349.                        FALSE,0,0,0,0,     {Disregard mouse cursor location}
  350.                        FALSE,0,0,0,0,     {ditto}
  351.                        msg,key,           {Messages & keys are what we want}
  352.                        junk,junk,junk,junk,junk); {Disregard other stuff}
  353.   END; {get_messages}
  354.  
  355.  
  356. FUNCTION check_messages : Boolean;
  357.   {Does all GEM stuff for print_file and returns true if printing cancelled}
  358.   VAR
  359.     cancelled : Boolean;
  360.   BEGIN
  361.     cancelled := FALSE;
  362.     get_messages;                        {From GEM}
  363.     IF (msg[0] = WM_Redraw) AND (msg[3] = progwind)
  364.       THEN do_redraw;                    {Redraw  window if GEM says so}
  365.     IF (msg[0] = WM_Moved) AND (msg[3] = progwind)
  366.       THEN do_move;                      {Move window if GEM says so}
  367.     IF (msg[0] = WM_Topped) AND (msg[3] = progwind)
  368.       THEN Bring_To_Front(progwind);     {Top window if GEM says so}
  369.     IF ((msg[0] = WM_Closed) AND (msg[3] = progwind)) {If progwind closed}
  370.       THEN cancelled := TRUE;                         {then cancelled}
  371.     IF (key & 255 = 27)                               {If escape key pressed}
  372.       THEN cancelled := TRUE;                         {then cancelled}
  373.     check_messages := cancelled;                      {Return result}
  374.   END; {check_messages}
  375.  
  376.  
  377. PROCEDURE show_cancel;                 {Informs user that printing was aborted}
  378.   VAR {Local}
  379.     errordata : String[255];  {Data for printing-aborted alert box}
  380.   BEGIN {show_cancel}
  381.     errordata := CONCAT ('[0]',               {No sign}
  382.       '[             ',CHR(28),CHR(29),' |',  {Bob}
  383.        '             ',CHR(30),CHR(31),' |',  {Bob}
  384.        '          Bob says          |',       {Text lines, 30 characters max}
  385.        'YOU ABORTED PRINTING BEFORE |',
  386.        'END OF FILE!                ]',
  387.        '[I Knew That]');                      {Button name}
  388.     junk := Do_Alert (errordata,1);           {Display box and wait for button}
  389.   END; {show_cancel}
  390.  
  391.  
  392. PROCEDURE print_bar; {Prints column spacing reference line}
  393.   BEGIN              {Numbers align with Personal Pascal tab settings}
  394.     WRITE (printer,'       0---|---1---|---2---|---3---|---4---|---');
  395.     WRITELN (printer, '5---|---6---|---7---|---8---|---9---|--');
  396.   END; {print_bar}
  397.  
  398.  
  399. PROCEDURE print_file;   {Lists selected disk file to printer}
  400.   VAR {Local}
  401.     i        : Integer;         {Multi-purpose counter}
  402.     oneline  : String [80];     {Stores one line of text}
  403.     done     : Boolean;         {Stores true/false to exit procedure}
  404.     pagefull : Boolean;         {Stores true/false for page full}
  405.     cancelled: Boolean;         {Stores true/false for printing cancelled}
  406.     select   : Char;            {Stores printer control code}
  407.     font     : Char;            {ditto}
  408.     elite    : Char;            {ditto}
  409.     lmargin  : Char;            {ditto}
  410.     five     : Char;            {ditto}
  411.     defaults : Char;            {ditto}
  412.     formfeed : Char;            {ditto}
  413.   BEGIN {print_file}
  414.     {Initialize variables}
  415.     linenum := 1;
  416.     pagenum := 1;
  417.     cancelled := FALSE;
  418.     select := CHR(27);          {Epson Escape}
  419.     font := CHR(33);            {Epson Master font selector}
  420.     elite := CHR(65);           {Epson Elite font}
  421.     lmargin := CHR(108);        {Epson Left margin selector}
  422.     five := CHR(5);             {Epson margin setting}
  423.     defaults := CHR(64);        {Epson master reset code}
  424.     formfeed := CHR(12);        {Epson formfeed}
  425.     pagestr := 'NOW ON PAGE: '; {Part of progress message}
  426.     linestr := '   LINE: ';     {Ditto}
  427.     WRITE (printer, select, defaults);       {Set printer}
  428.     WRITE (printer, select, font, elite);
  429.     WRITE (printer, select, lmargin, five);
  430.     create_progwind;        {Make window to show printing progress}
  431.     display_progwind;       {Display it}
  432.     {Print the file}
  433.     REPEAT
  434.       {Center file name at top of every page}
  435.       WRITELN (printer, userfile:43 + (LENGTH(userfile) DIV 2));
  436.       WRITELN (printer); {Print blank line}
  437.       print_bar; {Print column-spacing reference line at top of every page}
  438.       pagefull := false;
  439.       REPEAT
  440.         done := EOF(disk); {Check for end of diskfile}
  441.         IF NOT done
  442.           THEN
  443.             BEGIN
  444.               READLN (disk, oneline); {Read one line from disk file}
  445.               WRITELN (printer, linenum:4, '   ', oneline); {Print it}
  446.             END {If then}
  447.           ELSE  {If done}
  448.             WRITELN (printer); {Fill last page with blank lines}
  449.         pagefull := (linenum MOD 53 = 0); {Print 53 lines per page}
  450.         linenum := linenum+1;
  451.         update_linenum;  {Print current line number in progress window}
  452.         cancelled := check_messages;
  453.       UNTIL pagefull OR cancelled; {End Repeat}
  454.       IF NOT cancelled
  455.         THEN
  456.           BEGIN
  457.             print_bar; {Print column-spacing reference at bottom of all pages}
  458.             WRITELN (printer); {Skip a line}
  459.             WRITELN (printer, 'PAGE':43, pagenum:4); {Center pagenum}
  460.             FOR i := 1 to 7 DO WRITELN (printer); {Move to top of next page}
  461.             pagenum := pagenum+1;
  462.             update_pagenum; {Draw new page number in progress window}
  463.           END {If}
  464.         ELSE  {If cancelled}
  465.           BEGIN
  466.             WRITELN (printer);
  467.             WRITELN (printer,'*** PRINTING ABORTED BEFORE END OF FILE ***');
  468.             WRITE (printer,formfeed); {Move to top of next form}
  469.           END; {Else}
  470.     UNTIL done OR cancelled; {End repeat}
  471.     WRITE (printer, select, defaults);
  472.     CLOSE (disk);
  473.     Close_Window(progwind);         {Clean up screen}
  474.     Delete_Window(progwind);        {Release memory back to GEM}
  475.     IF cancelled
  476.       THEN show_cancel;
  477.   END; {print_file}
  478.  
  479.  
  480. PROCEDURE initialize;
  481.   BEGIN
  482.     Work_Rect (0,x,y,w,h);      {Find upperleft coordinate and size of desktop}
  483.     Sys_Font_Size (cw,ch,junk,junk); {Find size of text}
  484.     wwc := 30;                  {Start with window width of 30 characters}
  485.     whc := 8;                   {and a height of 8 characters}
  486.     ww := wwc * cw;             {Make window 'wwc' characters wide}
  487.     wh := whc * ch;             {Make window 'whc' text lines high}
  488.     wx := x+(w DIV 2)-(ww DIV 2); {Calculate coordinates to center window}
  489.     wy := y+(h DIV 2)-(wh DIV 2);
  490.     path := CONCAT                        {Set path for file selector to}
  491.       (CHR(current_drive + 65),           {current drive}
  492.       ':\*.PAS');                         {and '*.PAS' files}
  493.     runbefore := TRUE;
  494.  END; {initialize}
  495.  
  496.  
  497. PROCEDURE we_are_on; {Really main program of this accessory}
  498.   VAR
  499.     p,i     : Integer;
  500.     tempstr : String;
  501.   BEGIN
  502.     IF NOT(runbefore)                     {If first time accessory is run}
  503.       THEN initialize;                    {then initialize}
  504.     Set_Mouse(M_Arrow);                   {Ensure busy bee is off}
  505.     REWRITE (printer, 'LST:');            {Set printer as LIST device}
  506.     WHILE do_title DO                     {While user choice is 'print file'}
  507.       BEGIN
  508.         Begin_Update;         {Prevent main program messing up file selector}
  509.         picked := Get_In_File(path, userfile); {Display file selector}
  510.         End_Update;                     {Allow screen changes again}
  511.         IF picked THEN                  {If user selects file}
  512.           BEGIN
  513.             IF open_file(userfile) THEN {If file selected opens ok}
  514.               IF printer_ok THEN        {and if printer online}
  515.                 print_file;             {print the file}
  516.             p := POS('.',userfile);     {Find extender in selected file name}
  517.             IF p > 0                    {Put extender or '*' in tempstr}
  518.               THEN tempstr := COPY(userfile,p+1,LENGTH(userfile)-p)
  519.               ELSE tempstr := '*';
  520.             p := POS('.',path);         {Find period in file selector path}
  521.             IF p > 0 THEN               {If path has an extender}
  522.               path := COPY(path,1,p-1); {Strip extender from path}
  523.             path := CONCAT(path,'.',tempstr); {Add new extender to path}
  524.           END; {If picked}
  525.       END; {While}
  526.     END; {we_are_on}
  527.  
  528.  
  529. PROCEDURE Menu_Register( ap_id: integer; VAR name: String );
  530.   EXTERNAL; {Registers our desk accessory with GEM}
  531.  
  532.  
  533. BEGIN {Main Program}
  534.   ap_id := Init_Gem;
  535.   IF ap_id >= 0 THEN                        {If GEM available}
  536.     BEGIN                                   {Give name for DESK menu}
  537.       ourname := '  Pers Pascal Lister';
  538.       Menu_Register(ap_id,ourname);         {Register our accessory with GEM}
  539.       WHILE TRUE DO                         {This is always true}
  540.         BEGIN
  541.           get_messages;
  542.           IF msg[0] = AC_Open               {If our accessory opened}
  543.             THEN we_are_on;                 {then do our stuff}
  544.         END; {While}
  545.       Exit_Gem;                             {This will never execute}
  546.     END; {If ap_id >= 0}
  547. END. {Main Program}
  548.